{- |
Module      :  Segregate
Description :  <optional short text displayed on contents page>
Copyright   :  (c) Sergey Sichevskiy 2013
License     :  BSD3

Maintainer  :  s.sichevskij@gmal.com
Stability   :  experimental
Portability :  portable

Выделяет прямоугольные не пересекающиеся подмножества в заданном множестве,
так чтобы максимально перекрыть это множество ...

-}

module Segregate 
 ( segregate
 )
   where

import Control.Applicative ( (<$>) )
import Data.Function       ( on )
import Data.List           ( sort, sortBy, findIndices, (\\) )


-- |Функция 'segregate' выделяет прямоугольные не пересекающиеся
-- подмножества в заданном множестве, так чтобы максимально перекрыть это
-- множество ...
segregate :: (Ord a, Ord b) => [(a,[b])] -> [[(a,[b])]]
segregate = (order `map`) . segregate' [] . order
  where
    segregate' :: (Ord a, Ord b) => [[(a,[b])]] ->  [(a,[b])] -> [[(a,[b])]]
    segregate' ys [ ] = ys
    segregate' [] [_] = []
    segregate' ys xs
      | null ys'' = segregate' ys $ tail xs
      | otherwise = segregate' (ys'':ys) $ order xs''
      where
        es = intersect $ snd <$> xs

        (ys',xs') = xs `cut` es

        xs'' = (not.null.snd) `filter` xs'
        ys'' = (not.null.snd) `filter` ys'

-- |Функция 'order' упорядочивает ...
order :: (Ord a, Ord b) => [(a,[b])] -> [(a,[b])]
order xy = (compare `on` fst) `sortBy` ( (sort <$>) `map` xy )

-- |Функция 'cut' разрезает входной список ...
cut :: Eq b => [(a,[b])] -> [b] -> ( [(a,[b])], [(a,[b])] )
cut xs es = cut' [] [] xs
  where
    cut' ls rs [] = (ls,rs)
    cut' ls rs ((x,ys):ts)
      | length ys == length (ys'++es) = cut' ls' rs' ts
      | otherwise                     = (ls, (x,ys):ts ++ rs)
      where
        ls' = (x, es):ls
        rs' = (x,ys'):rs
        ys' = ys \\ es

-- |Функция 'intersect' возвращает пересечение списков ...
intersect :: Eq a => [[a]] -> [a]
intersect = intersect' []
  where
    intersect' :: Eq a => [a] -> [[a]] -> [a]
    
    intersect' ys [ ] = ys

    intersect' [] [_] = []

    intersect' [] (a:b:xs)
      | null ys || length ys < 2 = []
      | otherwise                = intersect' ys xs
      where
        is = (`elem` b) `findIndices` a
        ys = (a !!) <$> (select is) 

    intersect' ys (a:xs)
      | null ys' || length ys' < 2 = ys
      | otherwise                  = intersect' ys' xs
      where
        is  = (`elem` a) `findIndices` ys
        ys' = (ys !!) <$> (select is) 

-- |Функция 'select' возвращает первую найденную в входном списке
-- последовательность целых чисел, в которой последующий элемент отличается
-- от предыдущего на 1.
select :: [Int] -> [Int]
select = reverse . select' []
  where
    select' y  [ ] = y

    select' [] [_] = []

    select' []   (a:b:xs)
      | b - a == 1 = select' [b,a]    xs
      | otherwise  = select' []    (b:xs)

    select' (a:ts) (b:xs)
      | b - a == 1 = select' (b:a:ts) xs
      | otherwise  = a:ts